home *** CD-ROM | disk | FTP | other *** search
/ Komputer for Alle 1999 #5 / 1999 CD 5 (black).iso / Delphi3 / INFO / EXTRAS / ZLIB / TEST / TEST.PAS
Encoding:
Pascal/Delphi Source File  |  1997-03-24  |  1.7 KB  |  93 lines

  1. program Test;
  2.  
  3. uses Classes, SysUtils, ZLib;
  4.  
  5. const
  6.   BufferSize = 4096;
  7.   
  8. type
  9.   TTest = class
  10.     InFile: TStream;
  11.     OutFile: TStream;
  12.     ZStream: TCustomZLibStream;
  13.     Buffer: array[0..BufferSize-1] of Byte;
  14.     procedure Expand;
  15.     procedure Shrink;
  16.     procedure Status(Sender: TObject);
  17.   end;
  18.  
  19. procedure TTest.Shrink;
  20. begin
  21.   InFile := TFileStream.Create('c:\work\temp\test.pas', fmOpenRead);
  22.   try
  23.  
  24.     OutFile := TFileStream.Create('c:\work\temp\test.dat', fmCreate);
  25.     try
  26.  
  27.       ZStream := TCompressionStream.Create(clFastest, OutFile);
  28.       try
  29.         TCompressionStream(ZStream).OnProgress := Status;
  30.         ZStream.CopyFrom(InFile, 0);
  31.       finally
  32.         ZStream.Free;
  33.       end;
  34.  
  35.     finally
  36.       OutFile.Free;
  37.     end;
  38.   finally
  39.     InFile.Free;
  40.   end;
  41. end;
  42.  
  43.  
  44. procedure TTest.Expand;
  45. var
  46.   Count: Integer;
  47. begin
  48.   InFile := TFileStream.Create('c:\work\temp\test.dat', fmOpenRead);
  49.   try
  50.  
  51.     OutFile := TFileStream.Create('c:\work\temp\test.new', fmCreate);
  52.     try
  53.  
  54.       ZStream := TDecompressionStream.Create(InFile);
  55.       try
  56.         TDecompressionStream(ZStream).OnProgress := Status;
  57.         while True do
  58.           begin
  59.             Count := ZStream.Read(Buffer, BufferSize);
  60.             if Count <> 0 then OutFile.WriteBuffer(Buffer, Count) else Break;
  61.           end;
  62.       finally
  63.         ZStream.Free;
  64.       end;
  65.  
  66.     finally
  67.       OutFile.Free;
  68.     end;
  69.   finally
  70.     InFile.Free;
  71.   end;
  72. end;
  73.  
  74. procedure TTest.Status(Sender: TObject);
  75. begin
  76.   Writeln(TCustomZLibStream(Sender).Position);
  77. end;
  78.  
  79. var
  80.   T: TTest;
  81. begin
  82.   T := TTest.Create;
  83.   try
  84.     T.Shrink;
  85.     T.Expand;
  86.   finally
  87.     T.Free;
  88.   end;
  89.   Readln;
  90. end.
  91.  
  92.  
  93.